home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-2 / tests.sit / tests / recent1.icn < prev    next >
Encoding:
Text File  |  1992-12-08  |  4.4 KB  |  191 lines  |  [TEXT/????]
  1. procedure main ()
  2.    sf([])
  3.  
  4.    write(args(main))
  5.    write(args(write))
  6.  
  7. # show results of bitwise operations on various operand combinations
  8.  
  9.    every i := 1 | '2' | "3" do {
  10.       write (
  11.        "    i        j       ~j      i & j    i | j    i ^ j   i << j   i >> j")
  12.       every j := 0 | 1 | 2 | 3 | 4 | 100 do {
  13.          write(right(i,8), right(j,9))
  14.          word (i)
  15.          word (j)
  16.          word (icom (j))
  17.          word (iand (i, j))
  18.          word (ior (i, j))
  19.          word (ixor (i, j))
  20.          word (ishift (i, j))
  21.          word (ishift (i, -j))
  22.          write ()
  23.          }
  24.       }
  25.  
  26. # test remove() and rename(), and print errors in case of malfunction
  27.  
  28.    name1 := "temp1"
  29.    name2 := "temp2"
  30.    data := "Here's the data"
  31.  
  32.    every remove (name1 | name2)        # just in case
  33.    open (name1) & stop ("can't remove ", name1, " to initialize test")
  34.    open (name2) & stop ("can't remove ", name2, " to initialize test")
  35.    remove (name1) & stop ("successfully removed nonexistent file")
  36.    rename (name1, name2) & stop ("successfully renamed nonexistent file")
  37.  
  38.    f := open (name1, "w") | stop ("can't open ",name1," for write")
  39.    write (f, data)
  40.    close (f)
  41.  
  42.    f := open (name1) | stop ("can't open ",name1," after write")
  43.    s := read (f) | ""
  44.    close(f)
  45.    s == data | stop ("data lost after write")
  46.  
  47.    rename (name1, name2) | stop ("can't rename(",name1,",",name2,")")
  48.    f := open (name2) | stop ("can't open ",name2," after rename")
  49.    s := read (f) | ""
  50.    close(f)
  51.    s == data | stop ("data lost after rename")
  52.  
  53.    remove (name1) & stop ("remove succeeded on file already renamed")
  54.    remove (name2) | stop ("can't remove renamed file")
  55.    open (name1) & stop (name1, " still around at end of test")
  56.    open (name2) & stop (name2, " still around at end of test")
  57.  
  58. #  test seek() and where()
  59.  
  60.    f := open("concord.dat")
  61.    write(image(seek(f,11)))
  62.    write(where(f))
  63.    write(image(reads(f,10)))
  64.    write(where(f))
  65.    write(where(f))
  66.    seek(f,-2)
  67.    write(where(f))
  68.    write(image(reads(f,1)))
  69.    write(where(f))
  70.  
  71. end
  72.  
  73. # write word in hexadecimal
  74. procedure word (v)
  75.    xd (v, 8)
  76.    writes (" ")
  77.    return
  78.    end
  79.  
  80. # write n low-order hex digits of v
  81. procedure xd (v, n)
  82.    xd (ishift (v, -4), 0 < n - 1)
  83.    writes ("0123456789ABCDEF" [1 + iand (v, 16r0F)])
  84.    return
  85.    end
  86. # ferr(func,val,err) -- call func(val) and verify that error "err" is produced
  87.  
  88. procedure ferr (func, val, err)
  89.    write(msg := "oops -- " || image(func) || "(" || image (val) || ") ")
  90.    return
  91. end
  92.  
  93. procedure p(a, b, c[])
  94.    write("   image(a):", image(a))
  95.    write("   image(b):", image(b))
  96.    write("   image(c):", image(c))
  97.    write("   every write(\"\\t\", !c):")
  98.    every write("\t", !c)
  99. end
  100.  
  101. procedure q(a[])
  102.    write("   every write(\"\\t\", !a):")
  103.    every write("\t", !a)
  104. end
  105. procedure show(t)
  106.    local x
  107.  
  108.    write("   *t --> ", *t)
  109.    write("   t[\"xyz\"] --> ", image(t["xyz"]) | "failure")
  110.    write("   member(t, \"xyz\") --> ", image(member(t, "xyz")) | "failure")
  111.    x := sort(t, 3)
  112.    write("   contents of t:")
  113.    while writes("\t", image(get(x)), " : ")
  114.       do write(image(get(x)))
  115.    write("")
  116. end
  117.  
  118. #  test the new sortf(x,n) function
  119.  
  120. global data
  121. record r1(a)
  122. record r3(a,b,c)
  123.  
  124. procedure sf (args)
  125.     local n, z
  126.  
  127.     z := []
  128.     every put (z, 1 to 100)
  129.     data := [
  130.        r3(3,1,4),
  131.        [1,5,9],
  132.        r3(2,6,5),
  133.        r3(3,5),
  134.        r1(2),
  135.        3,
  136.        r1(4),
  137.        r1(8),
  138.        [5,&null,5],
  139.        [4,4,4,4],
  140.        [3,3,3],
  141.        [&null,25],
  142.        4,
  143.        [2,2],
  144.        [1],
  145.        [&null,&null],
  146.        [],
  147.        r3(7,8,9),
  148.        z]
  149.     dump ("sort(L)", sort (data))
  150.  
  151.     if *args = 0 then
  152.     every test (&null | 1 | "2" | '3' | 4 | 17 | -4 | -3 | "-2" | -1)
  153.     else
  154.     every test (!args)
  155.     end
  156.  
  157. procedure test (n)
  158.     local r1, r2
  159.     write ()
  160.     write ("-------------------- testing n = ", \n | "&null")
  161.     r1 := sortf (data, n)
  162.     r2 := sortf (set(data), n)
  163.     dump ("sortf(L,n)", r1)
  164.     if same (r1, r2) then
  165.     write ("\nsortf(S,n) [same]")
  166.     else
  167.     dump ("sortf(S,n) [********** OOPS -- results differ: **********]", r2)
  168.     end
  169.  
  170. procedure dump (s, l)
  171.     local e
  172.     write ()
  173.     write (s, ":")
  174.     every e := !l do {
  175.        writes ("  ", left(type(e), 8))
  176.        if (type(e) == ("r1" | "r3" | "list")) then
  177.       every writes (" ", image(e[(1 to 5) | (95 to 100)]) | "\n")
  178.        else
  179.       write (" ", image(e))
  180.        }
  181.     return
  182.     end
  183.  
  184. procedure same (a, b)
  185.     local i
  186.     if *a ~= *b then fail
  187.     every i := 1 to *a do
  188.     if a[i] ~=== b[i] then fail
  189.     return
  190.     end
  191.